home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / system / 4utils84.zip / stringda.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-08  |  13KB  |  491 lines
  1. UNIT StringDateHandling;
  2. {$F+} (* I'am using procedural variables! *)
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.  
  28.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  29.  
  30.    This unit provides the string handling and the date/time handling.
  31.  
  32.    ----------------------------------------------------------------------- *)
  33.  
  34. INTERFACE USES Dos;
  35.  
  36. TYPE  DateStr    = STRING[8];  (* 'mm-dd-yy','dd.mm.yy' or 'yy/mm/dd' *)
  37.       TimeStr    = STRING[6];  (* 'hh:mmp' or 'hh:mm'                 *)
  38.  
  39. VAR   DateFormat: DateStr; (* 'mm-dd-yy','dd.mm.yy','yy/mm/dd' or 'ddmmmyy' *)
  40.       TimeFormat: TimeStr; (* 'hh:mmp' or 'hh:mm'                           *)
  41.  
  42. (* String handling routines. The strings can be converted to lower/upper-
  43.    case. National characters will be converted.                           *)
  44.  
  45. FUNCTION  Chars(c: CHAR; Count: BYTE): STRING;
  46. FUNCTION  DownCase(C: CHAR): CHAR;
  47. FUNCTION  DownStr(s: STRING): STRING;
  48. PROCEDURE DownString(VAR s: STRING);
  49. FUNCTION  UpStr(s: STRING): STRING;
  50. PROCEDURE UpString(VAR s: STRING);
  51.  
  52. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  53. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  54.  
  55. (* Date/Time handling routines. Date/Time and Numbers will be formatted
  56.    in accordance with your COUNTRY=-settings in CONFIG.SYS.               *)
  57.  
  58. TYPE  FormDateFunc = FUNCTION (DateRec: DateTime) : DateStr;
  59.       FormTimeFunc = FUNCTION (DateRec: DateTime) : TimeStr;
  60.  
  61. VAR   FormDate : FormDateFunc;
  62.       FormTime : FormTimeFunc;
  63.  
  64.  
  65. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  66. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  67.  
  68. PROCEDURE EvaluateINIFileSettings;
  69.  
  70. IMPLEMENTATION USES HandleINIFile;
  71.  
  72. CONST MonthName: ARRAY[1..12] OF STRING[3] =
  73.                   ('Jan','Feb','Mar','Apr','May','Jun',
  74.                    'Jul','Aug','Sep','Oct','Nov','Dec');
  75.  
  76. CONST DateSep  : CHAR = '.';
  77.       TimeSep  : CHAR = ':';
  78.       MilleSep : CHAR = '''';
  79.  
  80. VAR   Buffer: ARRAY[0..15] OF CHAR;
  81.       (* Buffer for country code information.
  82.          This buffer may not be moved into GetCountryInfo,
  83.          since MS-DOS needs the address of this buffer!    *)
  84.  
  85. (*-------------------------------------------------------- String-Handling *)
  86. FUNCTION Chars(c: CHAR; Count: BYTE): STRING; ASSEMBLER;
  87. (* Concats Count times the character c *)
  88.  
  89. ASM
  90.  LES DI,@Result
  91.  MOV AL,&Count
  92.  CLD
  93.  STOSB
  94.  MOV CL,AL
  95.  XOR CH,CH
  96.  MOV AL,&c
  97.  REP STOSB
  98. END;
  99.  
  100. FUNCTION  DownCase(C: CHAR): CHAR; ASSEMBLER;
  101. (* Returns the character c in lower case, national characters will not
  102.    be handled correctly. [we will use this function to lowercase file
  103.    names and DOS doesn't like special characters in filenames anyway] *)
  104.  
  105. ASM
  106.   MOV AL,&c
  107.   CMP AL,'A'
  108.   JB  @@9                  (* No conversion below 'A'                     *)
  109.   CMP AL,'Z'
  110.   JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  111.   ADD AL,$20
  112. @@9:
  113. END;                       (* finished. *)
  114.  
  115. FUNCTION  DownStr(s: STRING): STRING; ASSEMBLER;
  116. (* Returns the string s in lower case, national characters will not
  117.    be handled correctly. [we will use this function to lowercase file
  118.    names and DOS doesn't like special characters in filenames anyway] *)
  119.  
  120. ASM
  121.  PUSH DS
  122.  CLD
  123.  LDS SI,s
  124.  LES DI,@Result
  125.  LODSB
  126.  STOSB
  127.  XOR AH,AH
  128.  XCHG AX,CX
  129.  JCXZ @11
  130. @10:
  131.  LODSB
  132.  CMP AL,'A'
  133.  JB  @@9                  (* No conversion below 'A'                     *)
  134.  CMP AL,'Z'
  135.  JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  136.  ADD AL,$20
  137. @@9:
  138.  STOSB
  139.  LOOP @10
  140. @11:
  141.  POP DS
  142. END;
  143.  
  144.  
  145. PROCEDURE DownString(VAR s: STRING);
  146. (* Returns the string s in lower case, national characters will not
  147.    be handled correctly. [we will use this function to lowercase file
  148.    names and DOS doesn't like special characters in filenames anyway] *)
  149.  
  150. VAR i : BYTE;
  151.  
  152. BEGIN
  153.  FOR i := 1 TO Length(s) DO s[i] := DownCase(s[i]);
  154. END;
  155.  
  156.  
  157. FUNCTION  UpStr(s: STRING): STRING; ASSEMBLER;
  158. (* Returns the string s in upper case, national characters will not
  159.    be handled correctly.                                              *)
  160.  
  161. ASM
  162.  PUSH DS
  163.  CLD
  164.  LDS SI,s
  165.  LES DI,@Result
  166.  LODSB
  167.  STOSB
  168.  XOR AH,AH
  169.  XCHG AX,CX
  170.  JCXZ @11
  171. @10:
  172.  LODSB
  173.  CMP AL,'a'
  174.  JB @@9
  175.  CMP AL,'z'
  176.  JA @@9
  177.  SUB AL,20H
  178. @@9:
  179.  STOSB
  180.  LOOP @10
  181. @11:
  182.  POP DS
  183. END;
  184.  
  185. PROCEDURE UpString(VAR s: STRING);
  186. (* Returns the string s in upper case, national characters will not
  187.    be handled correctly.                                              *)
  188.  
  189. VAR l : BYTE;
  190.  
  191. BEGIN
  192.  FOR l := 1 TO Length(s) DO s[l] := UpCase(s[l]);
  193. END;
  194.  
  195. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  196.  
  197. BEGIN
  198.  WHILE (Length(s) > 0) AND (s[1] = ' ') DO System.Delete(s,1,1);
  199. END;
  200.  
  201. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  202.  
  203. VAR l : BYTE;
  204.  
  205. BEGIN
  206.  l := Length(s);
  207.  WHILE (l>0) AND (s[l] = ' ') DO
  208.   BEGIN System.Delete(s,l,1); l := Length(s); END;
  209. END;
  210.  
  211. (*-------------------------------------------------------- Date-Handling *)
  212.  
  213. (* Various Date/Time format utilities to suit national date/time formats *)
  214.  
  215. FUNCTION FormDateEuropean(DateRec: DateTime): DateStr;
  216.  
  217. VAR MonStr, DayStr, YearStr : STRING[2];
  218.     res                     : DateStr;
  219.  
  220. BEGIN
  221.  Str(DateRec.Day:2, DayStr);
  222.  
  223.  Str(DateRec.Month:2, MonStr);
  224.  IF DateRec.Month < 10 THEN MonStr[1] := '0';
  225.  
  226.  DateRec.Year := DateRec.Year MOD 100;
  227.  Str(DateRec.Year:2, YearStr);
  228.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  229.  
  230.  FormDateEuropean := DayStr + DateSep + MonStr + DateSep + YearStr;
  231. END;
  232.  
  233. FUNCTION FormDateUS(DateRec: DateTime): DateStr;
  234.  
  235. VAR MonStr, DayStr, YearStr : STRING[2];
  236.     res                     : DateStr;
  237.  
  238. BEGIN
  239.  Str(DateRec.Day:2, DayStr);
  240.  IF DateRec.Day < 10 THEN DayStr[1] := '0';
  241.  
  242.  Str(DateRec.Month:2, MonStr);
  243.  
  244.  DateRec.Year := DateRec.Year MOD 100;
  245.  Str(DateRec.Year:2, YearStr);
  246.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  247.  
  248.  FormDateUS := MonStr + DateSep + DayStr + DateSep + YearStr;
  249. END;
  250.  
  251. FUNCTION FormDateJapanese(DateRec: DateTime): DateStr;
  252.  
  253. VAR MonStr, DayStr, YearStr : STRING[2];
  254.     res                     : DateStr;
  255.  
  256. BEGIN
  257.  Str(DateRec.Day:2, DayStr);
  258.  IF (DateRec.Day < 10) THEN DayStr[1] := '0';
  259.  
  260.  Str(DateRec.Month:2, MonStr);
  261.  IF (DateRec.Month < 10) THEN MonStr[1] := '0';
  262.  
  263.  DateRec.Year := DateRec.Year MOD 100;
  264.  Str(DateRec.Year:2, YearStr);
  265.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  266.  
  267.  FormDateJapanese := YearStr + DateSep + MonStr + DateSep + DayStr;
  268. END;
  269.  
  270. FUNCTION FormDateMyOwn(DateRec: DateTime): DateStr;
  271.  
  272. VAR DayStr, YearStr : STRING[2];
  273.     res             : DateStr;
  274.  
  275. BEGIN
  276.  Str(DateRec.Day:2, DayStr);
  277.  
  278.  DateRec.Year := DateRec.Year MOD 100;
  279.  Str(DateRec.Year:2, YearStr);
  280.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  281.  
  282.  FormDateMyOwn := DayStr + MonthName[DateRec.Month] + YearStr;
  283. END;
  284.  
  285. FUNCTION FormTime12(DateRec: DateTime): TimeStr;
  286.  
  287. VAR HourStr, MinStr, SecStr : STRING[2];
  288.     amflag                  : CHAR;
  289.     res                     : TimeStr;
  290.  
  291. BEGIN
  292.  IF DateRec.Hour < 12 THEN amflag := 'a'
  293.                       ELSE BEGIN amflag := 'p'; DEC(DateRec.Hour,12); END;
  294.  Str(DateRec.Hour:2,HourStr);
  295.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  296.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  297.  
  298.  FormTime12 := HourStr + TimeSep + MinStr + amflag;
  299. END;
  300.  
  301. FUNCTION FormTime24(DateRec: DateTime): TimeStr;
  302.  
  303. VAR HourStr, MinStr, SecStr : STRING[2];
  304.     res                     : TimeStr;
  305.  
  306. BEGIN
  307.  Str(DateRec.Hour:2,HourStr);
  308.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  309.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  310.  
  311.  FormTime24 := HourStr + TimeSep + MinStr;
  312. END;
  313.  
  314. (*------------------------------------------------ Formatting of numbers *)
  315.  
  316. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  317. (* Converts an integer number into a string of the form xxx'xxx...') *)
  318.  
  319. VAR helpstr  : STRING;
  320.     millestr : STRING[4];
  321.     n,i      : BYTE;
  322.  
  323. BEGIN
  324.  IF nr = 0 THEN FormattedIntStr := Chars(' ',minlength-1)+'0'
  325.  ELSE
  326.   BEGIN
  327.    helpstr := '';
  328.    n := nr DIV 1000; nr := nr MOD 1000;
  329.    IF n > 0 THEN
  330.     BEGIN
  331.      Str(n,helpstr);
  332.      helpstr := millestr+helpstr+MilleSep;
  333.     END;
  334.  
  335.    IF n = 0 THEN Str(nr,millestr)
  336.    ELSE
  337.     BEGIN
  338.      Str(nr:3,millestr);
  339.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  340.     END;
  341.    helpstr:=helpstr+millestr;
  342.    n := Length(helpstr);
  343.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  344.  
  345.    FormattedIntStr := helpstr;
  346.   END;
  347. END;
  348.  
  349. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  350. (* Converts a long integer number into a string of the form xxx'xxx...') *)
  351.  
  352. VAR helpstr  : STRING;
  353.     millestr : STRING[4];
  354.     n,i      : WORD;
  355.  
  356. BEGIN
  357.  IF nr = 0 THEN FormattedLongIntStr := Chars(' ',minlength-1)+'0'
  358.  ELSE
  359.   BEGIN
  360.    helpstr := '';
  361.  
  362.    n := nr DIV 1000000; nr := nr MOD 1000000;
  363.    IF n > 0 THEN
  364.     BEGIN
  365.      Str(n,millestr); helpstr := millestr+MilleSep;
  366.     END;
  367.  
  368.    n := nr DIV 1000; nr := nr MOD 1000;
  369.    IF n > 0 THEN
  370.     BEGIN
  371.      Str(n:3,millestr);
  372.      IF helpstr > '' THEN
  373.       BEGIN
  374.        FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  375.        helpstr := helpstr+millestr+MilleSep;
  376.       END
  377.      ELSE helpstr := millestr+MilleSep;
  378.     END;
  379.  
  380.    IF n = 0 THEN Str(nr,millestr)
  381.    ELSE
  382.     BEGIN
  383.      Str(nr:3,millestr);
  384.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  385.     END;
  386.    helpstr:=helpstr+millestr;
  387.    n := Length(helpstr);
  388.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  389.  
  390.    FormattedLongIntStr := helpstr;
  391.   END;
  392. END;
  393.  
  394. (*------------------------------------------------------- Initialisation *)
  395.  
  396. PROCEDURE GetCountryInfo;
  397.  
  398. VAR Regs  : Registers;
  399.  
  400. BEGIN
  401.  WITH Regs DO
  402.   BEGIN
  403.    ah := $38; (* Get / Set Country Data *)
  404.    al := $00;
  405.    ds := Seg(Buffer); dx := Ofs(Buffer); (* Address of Buffer *)
  406.   END;
  407.  MsDos(Regs);
  408.  
  409.  IF Regs.Flags AND FCarry = 0 THEN
  410.   BEGIN
  411.    MilleSep := Buffer[ 7];
  412.    DateSep  := Buffer[11];
  413.    TimeSep  := Buffer[13];
  414.   END;
  415.  
  416.  CASE Ord(Buffer[0]) OF
  417.   0 : BEGIN
  418.        FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  419.        FormTime := FormTime12;       TimeFormat := 'hh'+TimeSep+'mmp';
  420.       END;
  421.   1 : BEGIN
  422.        FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  423.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  424.       END;
  425.   2 : BEGIN
  426.        FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  427.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  428.       END;
  429.  ELSE
  430.   BEGIN
  431.    FormDate := FormDateEuropean;     DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  432.    FormTime := FormTime24;           TimeFormat := 'hh'+TimeSep+'mm';
  433.   END;
  434.  END; (* CASE *)
  435. END;
  436.  
  437. PROCEDURE EvaluateINIFileSettings;
  438.  
  439. VAR s : STRING[7];
  440.  
  441. BEGIN
  442.  MilleSep := ReadSettingsChar('dateandtimeformats','millesep',MilleSep);
  443.  TimeSep  := ReadSettingsChar('dateandtimeformats','timesep' ,TimeSep);
  444.  DateSep  := ReadSettingsChar('dateandtimeformats','datesep' ,DateSep);
  445.  
  446.  s := ReadSettingsString('dateandtimeformats','dateformat','ddmmmyy');
  447.  IF s = 'ddmmyy' THEN
  448.   BEGIN
  449.    FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  450.   END
  451.  ELSE
  452.  IF s = 'mmddyy' THEN
  453.   BEGIN
  454.    FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  455.   END
  456.  ELSE
  457.  IF s = 'yymmdd' THEN
  458.   BEGIN
  459.    FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  460.   END
  461.  ELSE
  462.   BEGIN
  463.    FormDate := FormDateMyOwn;    DateFormat := 'ddmmmyy';
  464.   END;
  465.  
  466.  s := ReadSettingsString('dateandtimeformats','timeformat','24');
  467.  IF s = '12' THEN
  468.   BEGIN
  469.    FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  470.   END
  471.  ELSE
  472.   BEGIN
  473.    FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  474.   END;
  475.  
  476.  s := ReadSettingsString('','ampm',''); (* from 4DOS.INI *)
  477.  IF s <> '' THEN
  478.   IF s = 'y' THEN
  479.    BEGIN
  480.     FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  481.    END
  482.   ELSE
  483.    BEGIN
  484.     FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  485.    END
  486. END;
  487.  
  488. BEGIN
  489.  GetCountryInfo;
  490. END.
  491.